home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
print.arc
/
CPP1651.RPG
next >
Wrap
Text File
|
1991-12-04
|
5KB
|
117 lines
/TITLE Print a charcter string.
* Program name - CPP1651
* Command processing program for command PRINT.
*
* This program will allow the use of printed
* output in CL or via command entry.
*
* Indicator 11 is used to control existance
* of headings output.
*
/SPACE
FQPRINT O F 255 OV PRINTER KPRTCTLPRTCTL
IHDRPRM DS
I B 01 020FILLER
I 03 03 HDRCTL
I 04 04 HDRRPL
IHDR DS 8
I 001 255 HDRDTA
I 256 256 HDRSPB
I 257 257 HDRSPA
I 258 259 HDRSKB
I 260 261 HDRSKA
I 256 261 HDRLSC
IPRTCTL DS
I 01 01 SPACEB
I 02 02 SPACEA
I 03 04 SKIPB
I 05 06 SKIPA
I 01 06 PRTLSC
I 07 090CURLIN
C *ENTRY PLIST
C PARM PRTDTA255
C SPACEA PARM SPA 1
C SPACEB PARM SPB 1
C SKIPA PARM SKA 2
C SKIPB PARM SKB 2
C INGOVF PARM INGOVF 1
C PARM HDRPRM
C PARM CLOSE 1
/SPACE
* Check for headings indication.
C HDRCTL IFEQ '1'
* If this is a heading, then set on the header switch
C MOVEL'1' *IN11
* If replace headings *YES, then
C HDRRPL IFEQ '1'
* Zap the headings counter.
C Z-ADD1 HDRCNT 30
C ELSE
* Else, increment the heading counter.
C ADD 1 HDRCNT
C END
* Set the heading data structure to the correct ocurrence
C HDRCNT OCUR HDR
* Move the printed data field, to the heading data structure
C MOVELPRTDTA HDRDTA
* Move the printer (heading) control codes to the data structure
C MOVELPRTLSC HDRLSC
C END
/SPACE
C HDRCTL IFEQ '0'
* If this is a normal printed line then continue.
/SPACE
C *INOV CASEQ'1' OVRFLO Overflow on?
C END
/SPACE
* If first line, then test for headings.
C DTLCNT CASEQ0 OVRFLO Print header
C END
/SPACE
C EXCPTPLINE Print line.
* Increment the line counter.
C ADD 1 DTLCNT 150
/SPACE
C END
/SPACE
C ENDPGM TAG
/SPACE
* Does the user want to close the printer file?
C CLOSE IFEQ '1' CLOSE(*YES)?
* Terminate process.
C MOVE '1' *INLR End program.
C ELSE Else, exit and
* Else, return and leave active.
C RETRN leave active.
C END
/SPACE
CSR OVRFLO BEGSR
* Set off the overflow idicator.
C MOVE '0' *INOV
* Are there any headings?
C *IN11 IFEQ '1'
* Print out each heading line.
C 1 DO HDRCNT X 30
* Set headings' data structure to X occurrance
C X OCUR HDR
* Put the heading spacing control codes into
* the printer control data structure.
C MOVELHDRLSC PRTLSC
* Print the headings
C EXCPTHLINE
C END
C ELSE
* If no headings, then check if ignore overflow(*NO)
C INGOVF IFEQ '0'
* If skip before is not specified, then force a SkipB(01)
C SKIPB ANDEQ*BLANKS
C MOVEL'01' SKIPB
C END
C END
/SPACE
CSR ENDOVR ENDSR
OQPRINT E HLINE
O HDRDTA 255
OQPRINT E PLINE
O PRTDTA 255